perm filename KK[RST,LCS] blob
sn#243198 filedate 1976-10-20 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE PT2
C00009 ENDMK
Cā;
SUBROUTINE PT2
INTEGER VALID
DIMENSION VALID(6),BARS(509)
DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C ADD MORE TO VALID LATER *****
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81)),(TOT,KBAR(2))
1,(BARS,KBAR(4))
CC 1,(RSTF,RSTFAC(100))
C TRNSP'S Bb, F, BBb, A, G, Eb.
55 FORMAT(F,2I)
CCC IF(RS.NE.'OLD')GO TO 2000
CALL GETFIL('BARS')
CALL FASTIN(KBAR,512)
CALL FASTIN(RSTFAC,128)
2000 TYPE 144
144 FORMAT(' STAFF SIZE, TRANSP. '$)
ACCEPT 55,SIZE,LL
IF(SIZE.NE.0)GO TO 101
SIZE=1
GO TO 33
101 DO 22 K=1,KT
22 BARS(K)=BARS(K)*SIZE
TOT=TOT*SIZE
33 IF(RSTJ2.EQ.0)RSTJ2=1
RA=JPG*SIZE*RSTJ2
MPG=10./RA
C MPG=NUM OF BRACES PER PAGE.
SPG=10./MPG
C SPG IS SPACE TO BE SET ABOVE STAFF 0
RA=(RSTJ2*SIZE)/RPSZ(1)
DO 141 K=1,JPG
141 RPSZ(K)=RPSZ(K)*RA
LPG=JPG
IF(MOD(LL,7).EQ.0)GO TO 140
DO 40 L=1,6
40 IF(LL.EQ.VALID(L))GO TO 140
TYPE 240
GO TO 2000
240 FORMAT(' THIS TRANSP NOT OFFERED')
140 TYPE 90,KT
RA=0
90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
JT=TOT/QLINE
C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
T=JT
16 AV=TOT/T
XAV=AV*.8
JT=T
C JT=TOTAL NUM OF LINES
LAST=0
ODIF=10000
NBAR(JT+1)=KT+1
C POINTER TO ONE BEYOND NUM. OF BARS
NBAR(1)=1
J=1
L=0
NT=JT-1
3 X=BARS(J)
1 J=J+1
IF(J.GT.KT)GO TO 2
C KT=NUM OF BARS
Y=BARS(J)
IF(L.EQ.NT)GO TO 5
C L=JT =LAST LINE -- PUT ALL THAT'S LEFT ON IT.
IF(X+Y/2.GT.XAV)GO TO 2
C MAKES LINES AS CLOSE TO AVERAGE AS POSSIBLE AT THIS POINT.
5 X=X+Y
GO TO 1
2 L=L+1
C L IS COUNTER FOR LINES (NUM OF BARS AND TOTAL LENGTH)
RN(L)=X
NBAR(L+1)=J
IF(L.LT.JT)GO TO 3
4 IF(LAST)GO TO 46
RMIN=10000
RMAX=0
JMIN=0
JMAX=0
DO 44 K=1,JT
X=RN(K)
IF(X.GE.RMIN)GO TO 45
RMIN=X
JMIN=K
GO TO 44
45 IF(X.LE.RMAX)GO TO 44
RMAX=X
JMAX=K
C FINDS MIN. AND MAX. LINE LENGTHS. (GETS POINTERS TOO.)
44 CONTINUE
RDIF=RMAX-RMIN
IF(RDIF.GT.ODIF)GO TO 46
CC IF(RDIF.GT.ODIF)LAST=-1
C ODIF SHOULD ALWAYS GET SMALLER - TIL LAST TIME.
ODIF=RDIF
C RIPPLE IT IF NECESSARY
IF(JMAX.GT.JMIN)GO TO 7
C NEXT IS FOR MAX. LINE LENGTH PRECEDING MIN.
JA=JMAX+1
JB=JMIN
JC=1
JD=-1
JE=-1
Z=-1
200 DO 20 K=JA,JB,JC
X=BARS(NBAR(K)+JE)
NBAR(K)=NBAR(K)+JD
RN(K-1)=RN(K-1)+X*Z
20 RN(K)=RN(K)-X*Z
GO TO 4
7 JA=JMAX
JB=JMIN+1
JC=-1
JD=1
JE=0
Z=1
GO TO 200
46 DO 21 K=JA,JB,JC
C MOVE THINGS BACK TO THE WAY THEY WERE BEFORE 'LAST'.
X=BARS(NBAR(K)+JE)
NBAR(K)=NBAR(K)-JD
RN(K-1)=RN(K-1)-X*Z
21 RN(K)=RN(K)+X*Z
J=1
TYPE 306,AV
DO 305 K=1,JT
NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
L=NBAR(K)-1+J
T=0
DO 18 M=J,L
18 T=T+BARS(M)
306 FORMAT(1XF4.0,3X8F4.0)
TYPE 306,T,(BARS(N),N=J,L)
305 J=L+1
RPG=JT
RPG=RPG/MPG
105 TYPE 104,RPG,JT
104 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
KA=0
ACCEPT 55,T,N,KL
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
IF(KL.NE.0)GO TO 110
C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
IF(T.EQ.0)GO TO 11
JT=T
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
111 FORMAT(36I)
110 REREAD 111,NBAR
911 DO 112 K=36,1,-1
KP=NBAR(K)
KA=KA+KP
112 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
IF(KA.NE.KT)GO TO 105
C MISMATCH!
N=26-2*MOD(KL-1,12)
IF(N.EQ.26)N=0
C TO SPACE OUT STAVES VERTICALLY
CC IF(IPG)GO TO 11
CC IF(NBAR(1).NE.0)GO TO 11
CC DO 711 K=1,36
CC IF(K.GT.J)IV(K)=0
CC711 NBAR(K)=IV(K)
CC GO TO 911
11 CALL WRTPAG
END